home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0032_Adlib-SB Music.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-26  |  5KB  |  195 lines
  1. (*
  2. ===========================================================================
  3.  BBS: Canada Remote Systems
  4. Date: 09-02-93 (00:16)             Number: 36877
  5. From: CATHY NICOLOFF               Refer#: NONE
  6.   To: ALL                           Recvd: NO
  7. Subj: Musical Notes!!!      1/2      Conf: (1221) F-PASCAL
  8. ---------------------------------------------------------------------------
  9. Here's some help for all you programmers out there! It's straight from
  10. my personal programming library!
  11.  
  12.  
  13. SBNotes : Array[1..12] Of Byte =
  14.       ($AE, $6B, $81, $98, $B0, $CA, $E5, $02, $20, $41, $63, $87);
  15.  
  16.    SBOctaves : Array[1..84] Of Byte =
  17.       ($22, $25, $25, $25, $25, $25, $25, $26, $26, $26, $26, $26,
  18.        $26, $29, $29, $29, $29, $29, $29, $2A, $2A, $2A, $2A, $2A,
  19.        $2A, $2D, $2D, $2D, $2D, $2D, $2D, $2E, $2E, $2E, $2E, $2E,
  20.        $2E, $31, $31, $31, $31, $31, $31, $32, $32, $32, $32, $32,
  21.        $32, $35, $35, $35, $35, $35, $35, $36, $36, $36, $36, $36,
  22.        $36, $39, $39, $39, $39, $39, $39, $3A, $3A, $3A, $3A, $3A,
  23.        $3A, $3D, $3D, $3D, $3D, $3D, $3D, $3E, $3E, $3E, $3E, $3E);
  24.  
  25.     Notes               : Array[1..84] Of Word =
  26.     { C    C#,D-  D    D#,E-  E     F    F#,G-  G    G#,A-  A    A#,B-  B  }
  27.     (0065, 0070, 0073, 0078, 0082, 0087, 0093, 0098, 0104, 0110, 0117, 0123,
  28.      0131, 0139, 0147, 0156, 0165, 0175, 0185, 0196, 0208, 0220, 0233, 0247,
  29.      0262, 0277, 0294, 0311, 0330, 0349, 0370, 0392, 0415, 0440, 0466, 0494,
  30.      0523, 0554, 0587, 0622, 0659, 0698, 0740, 0784, 0831, 0880, 0932, 0987,
  31.      1047, 1109, 1175, 1245, 1329, 1397, 1480, 1568, 1661, 1760, 1865, 1976,
  32.      2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951,
  33.      4186, 4435, 4699, 4978, 5274, 5588, 5920, 6272, 6645, 7040, 7459, 7902);
  34.  
  35. Explanation : This is used to emulate single note music (IE-ANSI music).
  36.  
  37. The array NOTES is the frequencies used to do a SOUND/NOSOUND on the PC
  38. speaker.
  39.  
  40. The SBNOTES and SBOCTAVES arrays are the hex values of the notes, and
  41. their octaves for any ADLIB compatible card.
  42.  
  43. Just take which note you want, and input the note AND the octave
  44. into the Adlib port. Here's some sample code to show you how :
  45. *)
  46.  
  47. Unit Music;
  48.  
  49. Interface
  50.  
  51. Uses Crt;
  52.  
  53. CONST
  54.  
  55. SBNotes : Array[1..12] Of Byte =
  56.       ($AE, $6B, $81, $98, $B0, $CA, $E5, $02, $20, $41, $63, $87);
  57.  
  58.    SBOctaves : Array[1..84] Of Byte =
  59.       ($22, $25, $25, $25, $25, $25, $25, $26, $26, $26, $26, $26,
  60.        $26, $29, $29, $29, $29, $29, $29, $2A, $2A, $2A, $2A, $2A,
  61.        $2A, $2D, $2D, $2D, $2D, $2D, $2D, $2E, $2E, $2E, $2E, $2E,
  62.        $2E, $31, $31, $31, $31, $31, $31, $32, $32, $32, $32, $32,
  63.        $32, $35, $35, $35, $35, $35, $35, $36, $36, $36, $36, $36,
  64.        $36, $39, $39, $39, $39, $39, $39, $3A, $3A, $3A, $3A, $3A,
  65.        $3A, $3D, $3D, $3D, $3D, $3D, $3D, $3E, $3E, $3E, $3E, $3E);
  66.  
  67.     Notes               : Array[1..84] Of Word =
  68.     { C    C#,D-  D    D#,E-  E     F    F#,G-  G    G#,A-  A    A#,B-  B  }
  69.     (0065, 0070, 0073, 0078, 0082, 0087, 0093, 0098, 0104, 0110, 0117, 0123,
  70.      0131, 0139, 0147, 0156, 0165, 0175, 0185, 0196, 0208, 0220, 0233, 0247,
  71.      0262, 0277, 0294, 0311, 0330, 0349, 0370, 0392, 0415, 0440, 0466, 0494,
  72.      0523, 0554, 0587, 0622, 0659, 0698, 0740, 0784, 0831, 0880, 0932, 0987,
  73.      1047, 1109, 1175, 1245, 1329, 1397, 1480, 1568, 1661, 1760, 1865, 1976,
  74.      2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951,
  75.      4186, 4435, 4699, 4978, 5274, 5588, 5920, 6272, 6645, 7040, 7459, 7902);
  76.  
  77. Procedure Play_SB(N, M : Byte);
  78. Procedure Init_SB;
  79. Procedure Reset_SB;
  80. Function Detect_SB : Boolean;
  81.  
  82. Implementation
  83.  
  84. (***********************)
  85.  
  86. Procedure Play_SB(N, M : Byte);
  87.  
  88. Var Loop  : Integer;
  89.     Temp  : Integer;
  90.  
  91. Begin
  92.   Port[$0388] := N;
  93.   For Loop := 1 To 6 Do
  94.      Temp := Port[$0388];
  95.   Port[$0389] := M;
  96.   For Loop:=1 To 35 Do
  97.      Temp := Port[$0388];
  98. End;
  99.  
  100. (***********************)
  101.  
  102. Procedure Init_SB;
  103.  
  104. Var
  105.    A : Integer;
  106.  
  107. Begin
  108.    For A := 1 to 244 Do
  109.       Play_SB(A,$00);
  110.    Play_SB($01,32);
  111.    Play_SB($B0,$11);
  112.    Play_SB($04,$60);
  113.    Play_SB($04,$80);
  114. End;
  115.  
  116. (***********************)
  117.  
  118. Procedure Reset_SB;
  119.  
  120. Begin
  121.    Play_SB($20,$41);
  122.    Play_SB($40,$10);
  123.    Play_SB($60,$F0);
  124.    Play_SB($80,$77);
  125.    Play_SB($23,$41);
  126.    Play_SB($43,$00);
  127.    Play_SB($63,$F0);
  128.    Play_SB($83,$77);
  129.    Play_SB($BD,$10);
  130. End;
  131.  
  132. (***********************)
  133.  
  134.  
  135. Function Detect_SB : Boolean;
  136.  
  137. Var
  138.    Dummy1,
  139.    Dummy2  : Byte;
  140.  
  141. Begin
  142.    Play_SB($04,$60);
  143.    Play_SB($04,$80);
  144.    Dummy1 := Port[$388];
  145.    Play_SB($02,$FF);
  146.    Play_SB($04,$21);
  147.    Delay(8);
  148.    Dummy2 := Port[$388];
  149.    Play_SB($04,$60);
  150.    Play_SB($04,$80);
  151.    If ((Dummy1 AND $E0) = $00) And ((Dummy2 AND $E0) = $C0) Then
  152.       Detect_SB := True
  153.    Else
  154.       Detect_SB := False;
  155. End;
  156.  
  157. (***********************)
  158.  
  159. End.
  160.  
  161. That is my own soundblaster unit I use to output.
  162.  
  163. To play note 'C' at octave 3, do the following :
  164.  
  165. Play_SB($A0, SBNotes[1]);
  166. Play_SB($B0, SBOctaves[1 + 3 * 12]);
  167.  
  168. To shut off Adlib output, do this :
  169.  
  170. Play_SB($83, $FF);
  171. Play_SB($B0, $11);
  172.  
  173. {   TEST PROGRAM }
  174.  
  175. Uses DOS,Crt,Music;
  176.  
  177. VAR I : BYTE;
  178.  
  179. BEGIN
  180. Init_SB;
  181. Reset_SB;
  182. FOR I := 1 To 8 DO
  183.     BEGIN
  184.     Play_SB($A0, SBNotes[i]);
  185.     Play_SB($B0, SBOctaves[i + 3 * 12]);
  186.     DELAY(500);
  187.     END;
  188. Init_SB;
  189. Reset_SB;
  190. END.
  191.  
  192.  
  193.  
  194.  
  195.